home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch15 / Rotate.frm (.txt) < prev    next >
Visual Basic Form  |  1999-06-25  |  16KB  |  493 lines
  1. VERSION 5.00
  2. Begin VB.Form frmRotate 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Rotate"
  6.    ClientHeight    =   5700
  7.    ClientLeft      =   690
  8.    ClientTop       =   615
  9.    ClientWidth     =   7830
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    KeyPreview      =   -1  'True
  21.    LinkTopic       =   "Form1"
  22.    PaletteMode     =   1  'UseZOrder
  23.    ScaleHeight     =   380
  24.    ScaleMode       =   3  'Pixel
  25.    ScaleWidth      =   522
  26.    Begin VB.CheckBox chkHideSurfaces 
  27.       Caption         =   "Hide Surfaces"
  28.       Height          =   255
  29.       Left            =   0
  30.       TabIndex        =   16
  31.       Top             =   5400
  32.       Width           =   2295
  33.    End
  34.    Begin VB.Frame Frame2 
  35.       Caption         =   "Curve"
  36.       Height          =   5295
  37.       Left            =   0
  38.       TabIndex        =   1
  39.       Top             =   0
  40.       Width           =   2295
  41.       Begin VB.OptionButton optCurve 
  42.          Caption         =   "Tornado"
  43.          Height          =   255
  44.          Index           =   13
  45.          Left            =   120
  46.          TabIndex        =   15
  47.          Top             =   4920
  48.          Width           =   2055
  49.       End
  50.       Begin VB.OptionButton optCurve 
  51.          Caption         =   "Helix"
  52.          Height          =   255
  53.          Index           =   12
  54.          Left            =   120
  55.          TabIndex        =   14
  56.          Top             =   4560
  57.          Width           =   2055
  58.       End
  59.       Begin VB.OptionButton optCurve 
  60.          Caption         =   "Tower"
  61.          Height          =   255
  62.          Index           =   11
  63.          Left            =   120
  64.          TabIndex        =   13
  65.          Top             =   4200
  66.          Width           =   2055
  67.       End
  68.       Begin VB.OptionButton optCurve 
  69.          Caption         =   "Football"
  70.          Height          =   255
  71.          Index           =   10
  72.          Left            =   120
  73.          TabIndex        =   12
  74.          Top             =   3840
  75.          Width           =   2055
  76.       End
  77.       Begin VB.OptionButton optCurve 
  78.          Caption         =   "Goblet"
  79.          Height          =   255
  80.          Index           =   9
  81.          Left            =   120
  82.          TabIndex        =   11
  83.          Top             =   3480
  84.          Width           =   2055
  85.       End
  86.       Begin VB.OptionButton optCurve 
  87.          Caption         =   "Urn"
  88.          Height          =   255
  89.          Index           =   8
  90.          Left            =   120
  91.          TabIndex        =   10
  92.          Top             =   3120
  93.          Width           =   2055
  94.       End
  95.       Begin VB.OptionButton optCurve 
  96.          Caption         =   "Sine Wave"
  97.          Height          =   255
  98.          Index           =   7
  99.          Left            =   120
  100.          TabIndex        =   9
  101.          Top             =   2760
  102.          Width           =   2055
  103.       End
  104.       Begin VB.OptionButton optCurve 
  105.          Caption         =   "Semicircle 2"
  106.          Height          =   255
  107.          Index           =   6
  108.          Left            =   120
  109.          TabIndex        =   8
  110.          Top             =   2400
  111.          Width           =   2055
  112.       End
  113.       Begin VB.OptionButton optCurve 
  114.          Caption         =   "Semicircle 1"
  115.          Height          =   255
  116.          Index           =   5
  117.          Left            =   120
  118.          TabIndex        =   7
  119.          Top             =   2040
  120.          Width           =   2055
  121.       End
  122.       Begin VB.OptionButton optCurve 
  123.          Caption         =   "Circle 2"
  124.          Height          =   255
  125.          Index           =   4
  126.          Left            =   120
  127.          TabIndex        =   6
  128.          Top             =   1680
  129.          Width           =   2055
  130.       End
  131.       Begin VB.OptionButton optCurve 
  132.          Caption         =   "Circle 1"
  133.          Height          =   255
  134.          Index           =   3
  135.          Left            =   120
  136.          TabIndex        =   5
  137.          Top             =   1320
  138.          Width           =   2055
  139.       End
  140.       Begin VB.OptionButton optCurve 
  141.          Caption         =   "3/4 Rectangle"
  142.          Height          =   255
  143.          Index           =   2
  144.          Left            =   120
  145.          TabIndex        =   4
  146.          Top             =   960
  147.          Width           =   2055
  148.       End
  149.       Begin VB.OptionButton optCurve 
  150.          Caption         =   "Diamond"
  151.          Height          =   255
  152.          Index           =   1
  153.          Left            =   120
  154.          TabIndex        =   3
  155.          Top             =   600
  156.          Width           =   2055
  157.       End
  158.       Begin VB.OptionButton optCurve 
  159.          Caption         =   "Rectangle"
  160.          Height          =   255
  161.          Index           =   0
  162.          Left            =   120
  163.          TabIndex        =   2
  164.          Top             =   240
  165.          Value           =   -1  'True
  166.          Width           =   2055
  167.       End
  168.    End
  169.    Begin VB.PictureBox picCanvas 
  170.       AutoRedraw      =   -1  'True
  171.       Height          =   5295
  172.       Left            =   2400
  173.       ScaleHeight     =   349
  174.       ScaleMode       =   3  'Pixel
  175.       ScaleWidth      =   357
  176.       TabIndex        =   0
  177.       Top             =   0
  178.       Width           =   5415
  179.    End
  180. Attribute VB_Name = "frmRotate"
  181. Attribute VB_GlobalNameSpace = False
  182. Attribute VB_Creatable = False
  183. Attribute VB_PredeclaredId = True
  184. Attribute VB_Exposed = False
  185. Option Explicit
  186. ' Location of viewing eye.
  187. Private EyeR As Single
  188. Private EyeTheta As Single
  189. Private EyePhi As Single
  190. Private Const dtheta = PI / 20
  191. Private Const Dphi = PI / 20
  192. Private Const Dr = 1
  193. ' Location of focus point.
  194. Private Const FocusX = 0#
  195. Private Const FocusY = 0#
  196. Private Const FocusZ = 0#
  197. Private Projector(1 To 4, 1 To 4) As Single
  198. Private SelectedCurve As Integer
  199. Private NumTrans As Integer
  200. Private trans() As Transformation
  201. Private TheSurface As Transformed3d
  202. ' Create the rotation transformation.
  203. Private Sub CreateTransformations()
  204. Dim T(1 To 4, 1 To 4) As Single
  205. Dim theta As Single
  206. Dim dtheta As Single
  207. Dim i As Integer
  208.     dtheta = 2 * PI / 12
  209.     For i = 1 To 12
  210.         theta = i * dtheta
  211.         m3YRotate T, theta      ' Rotate.
  212.         TheSurface.SetTransformation T
  213.     Next i
  214. End Sub
  215. ' Create the selected surface.
  216. Private Sub CreateSurface()
  217. Dim r As Single
  218. Dim offset As Single
  219. Dim dtheta As Single
  220. Dim theta As Single
  221. Dim Y As Single
  222.     Set TheSurface = New Transformed3d
  223.     Select Case SelectedCurve
  224.         Case 0  ' Rectangle.
  225.             TheSurface.AddCurvePoint -3, -1.5, 0
  226.             TheSurface.AddCurvePoint -1, -1.5, 0
  227.             TheSurface.AddCurvePoint -1, 1.5, 0
  228.             TheSurface.AddCurvePoint -3, 1.5, 0
  229.             TheSurface.AddCurvePoint -3, -1.5, 0
  230.         Case 1  ' Diamond.
  231.             TheSurface.AddCurvePoint -3, 0, 0
  232.             TheSurface.AddCurvePoint -2, -1, 0
  233.             TheSurface.AddCurvePoint -1, 0, 0
  234.             TheSurface.AddCurvePoint -2, 1, 0
  235.             TheSurface.AddCurvePoint -3, 0, 0
  236.         Case 2  ' 3/4 Rectangle.
  237.             TheSurface.AddCurvePoint 0, -1.5, 0
  238.             TheSurface.AddCurvePoint 0, 1.5, 0
  239.             TheSurface.AddCurvePoint -3, 1.5, 0
  240.             TheSurface.AddCurvePoint -3, -1.5, 0
  241.             TheSurface.AddCurvePoint 0, -1.5, 0
  242.         Case 3, 4   ' Circle 1, circle 2.
  243.             If SelectedCurve = 3 Then
  244.                 r = 2
  245.                 offset = 2
  246.             Else
  247.                 r = 1.5
  248.                 offset = 2.5
  249.             End If
  250.             dtheta = PI / 8
  251.             TheSurface.AddCurvePoint offset + r, 0, 0
  252.             For theta = -dtheta To -2 * PI + dtheta + 0.1 Step -dtheta
  253.                 TheSurface.AddCurvePoint _
  254.                     offset + r * Cos(theta), r * Sin(theta), 0
  255.             Next theta
  256.             TheSurface.AddCurvePoint offset + r, 0, 0
  257.         Case 5, 6   ' Semicircle 1, semicircle 2.
  258.             If SelectedCurve = 5 Then
  259.                 r = 4
  260.                 offset = 0
  261.             Else
  262.                 r = 2
  263.                 offset = 2
  264.             End If
  265.             dtheta = PI / 8
  266.             TheSurface.AddCurvePoint offset, r, 0
  267.             For theta = PI / 2 - dtheta To -PI / 2 + dtheta - 0.1 Step -dtheta
  268.                 TheSurface.AddCurvePoint _
  269.                     offset + r * Cos(theta), _
  270.                     r * Sin(theta), _
  271.                     0
  272.             Next theta
  273.             TheSurface.AddCurvePoint offset, r, 0
  274.         Case 7  ' Sine wave.
  275.             r = 0.7
  276.             dtheta = PI / 10
  277.             TheSurface.AddCurvePoint 0, PI, 0
  278.             For theta = PI To -PI Step -dtheta
  279.                 TheSurface.AddCurvePoint _
  280.                     1 + r + r * Sin(2 * theta), _
  281.                     theta, _
  282.                     0
  283.             Next theta
  284.             TheSurface.AddCurvePoint 0, -PI, 0
  285.             TheSurface.AddCurvePoint 0, PI, 0
  286.         Case 8  ' Urn.
  287.             dtheta = PI / 10
  288.             TheSurface.AddCurvePoint 0, PI, 0
  289.             For theta = PI To -PI Step -dtheta
  290.                 TheSurface.AddCurvePoint _
  291.                     PI / 2 + (-PI + theta) / 4 * Sin(2 * theta), _
  292.                     theta, _
  293.                     0
  294.             Next theta
  295.             theta = -PI
  296.             TheSurface.AddCurvePoint _
  297.                 PI / 2 + (-PI + theta) / 4 * Sin(2 * theta), _
  298.                 theta, _
  299.                 0
  300.             TheSurface.AddCurvePoint 0, -PI, 0
  301.             TheSurface.AddCurvePoint 0, PI, 0
  302.         Case 9  ' Goblet.
  303.             TheSurface.AddCurvePoint 0, 3.5, 0
  304.             TheSurface.AddCurvePoint 3, 3.5, 0
  305.             TheSurface.AddCurvePoint 2.5, 3, 0
  306.             TheSurface.AddCurvePoint 3, 1.5, 0
  307.             TheSurface.AddCurvePoint 2.5, 1, 0
  308.             TheSurface.AddCurvePoint 1, 1, 0
  309.             TheSurface.AddCurvePoint 0.5, 0.5, 0
  310.             TheSurface.AddCurvePoint 0.5, -1, 0
  311.             TheSurface.AddCurvePoint 1, -1.5, 0
  312.             TheSurface.AddCurvePoint 2, -1.5, 0
  313.             TheSurface.AddCurvePoint 2.5, -2, 0
  314.             TheSurface.AddCurvePoint 0, -2, 0
  315.             TheSurface.AddCurvePoint 0, 3.5, 0
  316.         Case 10 ' Football.
  317.             For Y = 4 To -4 Step -0.5
  318.                 TheSurface.AddCurvePoint 16 / 5 - Y * Y / 5, Y, 0
  319.             Next Y
  320.         Case 11 ' Tower.
  321.             r = 1
  322.             dtheta = PI / 8
  323.             For theta = -PI To -PI / 2 Step dtheta
  324.                 TheSurface.AddCurvePoint _
  325.                     r + r * Cos(theta), _
  326.                     4 * r + r * Sin(theta), _
  327.                     0
  328.             Next theta
  329.             For theta = PI / 2 To -PI / 2 Step -dtheta
  330.                 TheSurface.AddCurvePoint _
  331.                     r + r * Cos(theta), _
  332.                     2 * r + r * Sin(theta), _
  333.                     0
  334.             Next theta
  335.             TheSurface.AddCurvePoint r, -3, 0
  336.             TheSurface.AddCurvePoint 0, -3, 0
  337.             TheSurface.AddCurvePoint 0, 4 * r, 0
  338.         Case 12 ' Helix.
  339.             r = 2
  340.             dtheta = PI / 4
  341.             TheSurface.AddCurvePoint 0, PI, 0
  342.             For theta = PI To -PI Step -dtheta
  343.                 TheSurface.AddCurvePoint _
  344.                     r * Cos(theta / 2), _
  345.                     theta, _
  346.                     r * Sin(theta / 2)
  347.             Next theta
  348.             theta = -PI
  349.             TheSurface.AddCurvePoint _
  350.                 r * Cos(theta / 2), _
  351.                 theta, _
  352.                 r * Sin(theta / 2)
  353.             TheSurface.AddCurvePoint 0, -PI, 0
  354.             TheSurface.AddCurvePoint 0, PI, 0
  355.         Case 13 ' Tornado.
  356.             r = 2
  357.             dtheta = PI / 4
  358.             TheSurface.AddCurvePoint 0, PI, 0
  359.             For theta = PI To -PI Step -dtheta
  360.                 r = 2 + theta / 2
  361.                 TheSurface.AddCurvePoint _
  362.                     r * Cos(theta / 2), _
  363.                     theta, _
  364.                     r * Sin(theta / 2)
  365.             Next theta
  366.             theta = -PI
  367.             TheSurface.AddCurvePoint _
  368.                 r * Cos(theta / 2), _
  369.                 theta, _
  370.                 r * Sin(theta / 2)
  371.             TheSurface.AddCurvePoint 0, -PI, 0
  372.             TheSurface.AddCurvePoint 0, PI, 0
  373.     End Select
  374. End Sub
  375. Private Sub chkHideSurfaces_Click()
  376.     Screen.MousePointer = vbHourglass
  377.     DoEvents
  378.     DrawData picCanvas
  379.     picCanvas.SetFocus
  380.     Screen.MousePointer = vbDefault
  381. End Sub
  382. Private Sub Form_Resize()
  383. Dim wid As Single
  384.     wid = ScaleWidth - picCanvas.Left
  385.     If wid < 120 Then wid = 120
  386.     picCanvas.Move picCanvas.Left, 0, wid, ScaleHeight
  387. End Sub
  388. ' Create a new curve and rotate it.
  389. Private Sub optCurve_Click(Index As Integer)
  390. Dim i As Integer
  391.     Screen.MousePointer = vbHourglass
  392.     DoEvents
  393.     SelectedCurve = Index
  394.     CreateSurface
  395.     CreateTransformations
  396.     For i = 1 To NumTrans
  397.         TheSurface.SetTransformation trans(i).M
  398.     Next i
  399.     TheSurface.Transform
  400.     DrawData picCanvas
  401.     picCanvas.SetFocus
  402.     Screen.MousePointer = vbDefault
  403. End Sub
  404. ' Draw the data.
  405. Private Sub DrawData(ByVal pic As PictureBox)
  406. Dim X As Single
  407. Dim Y As Single
  408. Dim z As Single
  409. Dim S(1 To 4, 1 To 4) As Single
  410. Dim T(1 To 4, 1 To 4) As Single
  411. Dim ST(1 To 4, 1 To 4) As Single
  412. Dim PST(1 To 4, 1 To 4) As Single
  413.     ' Prevent overflow errors when drawing lines
  414.     ' too far out of bounds.
  415.     On Error Resume Next
  416.     ' Uncull the surface.
  417.     TheSurface.Culled = False
  418.     ' Cull backfaces.
  419.     If chkHideSurfaces.value = vbChecked Then
  420.         m3SphericalToCartesian EyeR, EyeTheta, EyePhi, X, Y, z
  421.         TheSurface.HideSurfaces = True
  422.         TheSurface.Cull X, Y, z
  423.     Else
  424.         TheSurface.HideSurfaces = False
  425.     End If
  426.     ' Scale and translate so it looks OK in pixels.
  427.     m3Scale S, 30, -30, 1
  428.     m3Translate T, picCanvas.ScaleWidth / 2, picCanvas.ScaleHeight / 2, 0
  429.     m3MatMultiplyFull ST, S, T
  430.     m3MatMultiplyFull PST, Projector, ST
  431.     ' Transform the surface and clip faces.
  432.     TheSurface.ApplyFull PST
  433.     ' Clip faces behind the center of projection.
  434.     TheSurface.ClipEye EyeR
  435.     ' Set the appropriate fill style.
  436.     If chkHideSurfaces.value = vbChecked Then
  437.         ' Fill to cover hidden surfaces.
  438.         pic.FillStyle = vbFSSolid
  439.         pic.FillColor = RGB(&HC0, &HFF, &HC0)
  440.     Else
  441.         ' Do not fill so all lines are visible.
  442.         pic.FillStyle = vbFSTransparent
  443.     End If
  444.     ' Draw the surface.
  445.     pic.Cls
  446.     TheSurface.Draw pic, EyeR
  447.     pic.Refresh
  448. End Sub
  449. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  450.     Select Case KeyCode
  451.         Case vbKeyLeft
  452.             EyeTheta = EyeTheta - dtheta
  453.         
  454.         Case vbKeyRight
  455.             EyeTheta = EyeTheta + dtheta
  456.         
  457.         Case vbKeyUp
  458.             EyePhi = EyePhi - Dphi
  459.         
  460.         Case vbKeyDown
  461.             EyePhi = EyePhi + Dphi
  462.                 
  463.         Case Else
  464.             Exit Sub
  465.     End Select
  466.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  467.     DrawData picCanvas
  468. End Sub
  469. Private Sub Form_KeyPress(KeyAscii As Integer)
  470.     Select Case KeyAscii
  471.         Case Asc("+")
  472.             EyeR = EyeR + Dr
  473.         
  474.         Case Asc("-")
  475.             EyeR = EyeR - Dr
  476.         
  477.         Case Else
  478.             Exit Sub
  479.     End Select
  480.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  481.     DrawData picCanvas
  482. End Sub
  483. Private Sub Form_Load()
  484.     ' Initialize the eye position.
  485.     EyeR = 10
  486.     EyeTheta = PI * 0.2
  487.     EyePhi = PI * 0.1
  488.     ' Initialize the projection transformation.
  489.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  490.     Me.Show
  491.     optCurve_Click 0
  492. End Sub
  493.